home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue39 / Alfresco / PQTest.dpr < prev    next >
Encoding:
Text File  |  1998-10-07  |  5.0 KB  |  198 lines
  1. program PQTest;
  2.  
  3. {$IFDEF Win32}
  4. {$APPTYPE CONSOLE}
  5. {$ENDIF}
  6.  
  7. uses
  8.   SysUtils,
  9.   Classes,
  10.   {$IFDEF Windows}
  11.   WinCrt,
  12.   {$ENDIF}
  13.   PriQueue in 'PriQueue.pas',
  14.   HeapSort in 'HeapSort.pas';
  15.  
  16. type
  17.   TMyItem = class
  18.     public
  19.       miString   : string[31];
  20.       miPriority : integer;
  21.   end;
  22.  
  23. function CreateRandomItem : TMyItem;
  24. var
  25.   i : integer;
  26. begin
  27.   Result := TMyItem.Create;
  28.   with Result do begin
  29.     miString[0] := char(Random(10) + 20);
  30.     for i := 1 to length(miString) do
  31.       miString[i] := char(Random(26) + ord('A'));
  32.     miPriority := Random(200);
  33.   end;
  34. end;
  35.  
  36. function MyCompare(const aItem1, aItem2 : pointer) : integer; far;
  37. var
  38.   One : TMyItem absolute aItem1;
  39.   Two : TMyItem absolute aItem2;
  40. begin
  41.   if (One.miPriority < Two.miPriority) then
  42.     Result := -1
  43.   else if (One.miPriority = Two.miPriority) then
  44.     Result := 0
  45.   else
  46.     Result := 1
  47. end;
  48.  
  49. function MyLessThan(const aItem1, aItem2 : pointer) : boolean; far;
  50. var
  51.   One : TMyItem absolute aItem1;
  52.   Two : TMyItem absolute aItem2;
  53. begin
  54.   Result := (One.miPriority < Two.miPriority);
  55. end;
  56.  
  57. var
  58.   i     : integer;
  59.   MyPQA : TaaPriorityQueueA;
  60.   MyPQB : TaaPriorityQueueB;
  61.   MyPQ  : TaaPriorityQueue;
  62.   MyPQEx : TaaPriorityQueueEx;
  63.   Item  : TMyItem;
  64.   MyList: TList;
  65.   MyHandles : array [1..20] of TaaPQHandle;
  66.  
  67.  
  68. begin
  69.   Randomize;
  70.   writeln('---Testing priority queue A---');
  71.   MyPQA := TaaPriorityQueueA.Create(MyCompare);
  72.   writeln('   add 20 items');
  73.   for i := 1 to 20 do
  74.     MyPQA.Add(CreateRandomItem);
  75.   writeln('   remove all items');
  76.   while (MyPQA.Count > 0) do begin
  77.     Item := TMyItem(MyPQA.Remove);
  78.     writeln('      ', Item.miPriority:2, ' ', Item.miString);
  79.   end;
  80.   MyPQA.Free;
  81.   readln;
  82.  
  83.  
  84.   writeln('---Testing priority queue B---');
  85.   MyPQB := TaaPriorityQueueB.Create(MyCompare);
  86.   writeln('   add 20 items');
  87.   for i := 1 to 20 do
  88.     MyPQB.Add(CreateRandomItem);
  89.   writeln('   remove all items');
  90.   while (MyPQB.Count > 0) do begin
  91.     Item := TMyItem(MyPQB.Remove);
  92.     writeln('      ', Item.miPriority:2, ' ', Item.miString);
  93.   end;
  94.   MyPQB.Free;
  95.   readln;
  96.  
  97.  
  98.   writeln('---Testing final priority queue---');
  99.   MyPQ := TaaPriorityQueue.Create(MyCompare);
  100.   writeln('   add 20 items');
  101.   for i := 1 to 20 do
  102.     MyPQ.Add(CreateRandomItem);
  103.   {
  104.   for i := 1 to 20 do begin
  105.     Item := TMyItem(MyPQ.List[i-1]);
  106.     writeln('      ', Item.miPriority:2, ' ', Item.miString);
  107.   end;
  108.   readln;
  109.   }
  110.   writeln('   remove all items');
  111.   while (MyPQ.Count > 0) do begin
  112.     Item := TMyItem(MyPQ.Remove);
  113.     writeln('      ', Item.miPriority:2, ' ', Item.miString);
  114.   end;
  115.   MyPQ.Free;
  116.   readln;
  117.  
  118.  
  119.   writeln('---Testing final priority queue by passing a preset list---');
  120.   MyList := TList.Create;
  121.   for i := 1 to 20 do
  122.     MyList.Add(CreateRandomItem);
  123.   MyPQ := TaaPriorityQueue.CreateWithList(MyCompare, MyList);
  124.   for i := 1 to 20 do begin
  125.     Item := TMyItem(MyPQ.List[i-1]);
  126.     writeln('      ', Item.miPriority:2, ' ', Item.miString);
  127.   end;
  128.   readln;
  129.   writeln('   remove all items');
  130.   while (MyPQ.Count > 0) do begin
  131.     Item := TMyItem(MyPQ.Remove);
  132.     writeln('      ', Item.miPriority:2, ' ', Item.miString);
  133.   end;
  134.   MyPQ.Free;
  135.   MyList.Free;
  136.   readln;
  137.  
  138.  
  139.   writeln('---Testing heap sort---');
  140.   MyList := TList.Create;
  141.   for i := 1 to 20 do
  142.     MyList.Add(CreateRandomItem);
  143.   AAHeapSort(MyList, 2, 17, MyLessThan);
  144.   writeln('   3rd to 18th items should be sorted');
  145.   for i := 1 to 20 do begin
  146.     Item := TMyItem(MyList[i-1]);
  147.     writeln('      ', Item.miPriority:2, ' ', Item.miString);
  148.   end;
  149.   MyList.Free;
  150.   readln;
  151.  
  152.  
  153.   writeln('---Testing extended priority queue---');
  154.   MyPQEx := TaaPriorityQueueEx.Create(MyCompare);
  155.   writeln('   add 20 items');
  156.   for i := 1 to 20 do
  157.     MyPQEx.Add(CreateRandomItem);
  158.   {
  159.   for i := 1 to 20 do begin
  160.     Item := TMyItem(MyPQ.List[i-1]);
  161.     writeln('      ', Item.miPriority:2, ' ', Item.miString);
  162.   end;
  163.   }
  164.   writeln('   remove all items');
  165.   while (MyPQEx.Count > 0) do begin
  166.     Item := TMyItem(MyPQEx.Remove);
  167.     writeln('      ', Item.miPriority:2, ' ', Item.miString);
  168.   end;
  169.   MyPQEx.Free;
  170.   readln;
  171.  
  172.  
  173.  
  174.   writeln('---Testing extended priority queue delete and replace---');
  175.   MyPQEx := TaaPriorityQueueEx.Create(MyCompare);
  176.   writeln('   add 20 items');
  177.   for i := 1 to 20 do
  178.     MyHandles[i] := MyPQEx.Add(CreateRandomItem);
  179.   writeln('   delete every 4th item');
  180.   MyPQEx.Delete(MyHandles[4]);
  181.   MyPQEx.Delete(MyHandles[8]);
  182.   MyPQEx.Delete(MyHandles[12]);
  183.   MyPQEx.Delete(MyHandles[16]);
  184.   MyPQEx.Delete(MyHandles[20]);
  185.   writeln('   replace every 5th item (note the leaks)');
  186.   MyPQEx.Replace(MyHandles[5], CreateRandomItem);
  187.   MyPQEx.Replace(MyHandles[10], CreateRandomItem);
  188.   MyPQEx.Replace(MyHandles[15], CreateRandomItem);
  189.   writeln('   remove all items');
  190.   while (MyPQEx.Count > 0) do begin
  191.     Item := TMyItem(MyPQEx.Remove);
  192.     writeln('      ', Item.miPriority:2, ' ', Item.miString);
  193.   end;
  194.   MyPQEx.Free;
  195.   readln;
  196.  
  197. end.
  198.